home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).zip / Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).adf / GFA.Beispiel / LOADILBM_V1.0.LST < prev    next >
File List  |  1992-09-14  |  11KB  |  303 lines
  1. ' *********************************
  2. ' *       LoadILBM V.1.00         *
  3. ' *  (c) 11.6.1991 by Henry König *
  4. ' * Bornheide 71, 2000 Hamburg 53 *
  5. ' *********************************
  6. '
  7. init
  8. ON MENU GOSUB menuekontrolle
  9. REPEAT
  10.   SLEEP
  11. UNTIL ende!
  12. CLOSES 1
  13. CLOSEW #1
  14. END
  15. PROCEDURE fileauswahl(titel$,oktext$,VAR pfad$,name$)
  16.   LOCAL pos%
  17.   FILESELECT titel$,oktext$,pfad$,name$
  18.   pos%=RINSTR(name$,"/")
  19.   IF pos%=0 THEN
  20.     pos%=RINSTR(name$,":")
  21.   ENDIF
  22.   IF pos%<>0
  23.     pfad$=MID$(name$,1,pos%)
  24.     bildname$=MID$(name$,pos%+1)
  25.     CLR abbruch%
  26.   ELSE
  27.     abbruch%=1
  28.   ENDIF
  29. RETURN
  30. PROCEDURE initvars
  31.   DIM m$(31)
  32.   breite%=320                   ! Screenbreite
  33.   hoehe%=256                    ! Screenhöhe
  34.   ebenen%=5                     ! Anzahl der Bitplanes
  35.   farb%=32                      ! Anzahl der Farben zum zeichnen
  36.   DIM farben%(31,2)             ! Farbwerte zum Speichern des IFF-Bildes
  37.   DIM ebnadr%(10)               ! wie vor
  38.   pfad$=DIR$(0)                 ! System-Pfad
  39.   ende!=FALSE
  40. RETURN
  41. PROCEDURE init                  !
  42.   initvars                      ! Variable initialisieren
  43.   OPENS 1,0,0,breite%,hoehe%,ebenen%,&H0
  44.   OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
  45.   scradr%=SCREEN(1)
  46.   planesize%=DPEEK(scradr%+184)*DPEEK(scradr%+186)
  47.   menueein
  48.   MENU m$()                     ! Menü setzen
  49. RETURN
  50. PROCEDURE lese.chunkname        ! Chunknamen und Chunklänge einlesen
  51.   form$=""
  52.   FOR i%=1 TO 8
  53.     form$=form$+CHR$(INP(k%))
  54.   NEXT i%
  55. RETURN
  56. PROCEDURE lese.grafik(k%)       ! Grafik einlesen und anzeigen
  57.   form$=""
  58.   SEEK #k%,filepointer%
  59.   WHILE LEFT$(form$,4)<>"BODY"
  60.     lese.chunkname              ! Chunknamen und Chunklänge lesen
  61.     IF LEFT$(form$,4)<>"BODY" THEN
  62.       lg1%=@chlaenge(form$)
  63.       SEEK #k%,LOC(#k%)+lg1%
  64.     ENDIF
  65.   WEND
  66.   mem%=MALLOC(2,0)              ! 2 Bytes Speicher reservieren
  67.   modus%=0                      ! Modus auf Standard setzen
  68.   hoehe%=256                    ! mindestens 256 Zeilen für die Malroutine
  69.   IF breite%>320 THEN           ! Bildbreite größer 320 Spalten?
  70.     modus%=32768                ! Hires-Modus
  71.   ENDIF
  72.   IF i_hoehe%>256 THEN          ! Bildhöhe größer als 256 Zeilen?
  73.     ADD modus%,4                ! ja, dann Interlace-Modus
  74.     hoehe%=i_hoehe%             ! für die Malroutine
  75.   ENDIF
  76.   IF ebenen%>5 THEN             ! mehr als 5 Bitplanes?
  77.     ADD modus%,2048             ! ja. dann HAM-Modus
  78.   ENDIF
  79.   CLOSEW #1                     ! Fenster schließen
  80.   CLOSES 1                      ! Bildschirm schließen
  81.   OPENS 1,0,0,breite%,hoehe%,ebenen%,modus%
  82.   OPENW #1,0,0,breite%,hoehe%,&H18,4096+2048
  83.   wadr%=WINDOW(1)               ! aktuelle Fensteradresse
  84.   rp%=LPEEK(wadr%+50)           ! Rastportadresse
  85.   bm%=LPEEK(rp%+4)              ! Adresse der Bitmap-Struktur
  86.   FOR i%=0 TO ebenen%-1
  87.     ebnadr%(i%)=LPEEK(bm%+8+4*i%) ! Adressen der Bitplanes
  88.   NEXT i%
  89.   FOR i%=0 TO farb%-1           ! Anzahl der Farben
  90.     SETCOLOR i%,farben%(i%,0),farben%(i%,1),farben%(i%,2)
  91.   NEXT i%
  92.   IF comp%=0 THEN               ! Bild nicht gepackt
  93.     FOR j1%=0 TO i_hoehe%-1     ! Anzahl der Bildzeilen in Pixel
  94.       FOR j2%=0 TO ebenen%-1    ! Anzahl der Bitplanes
  95.         scrz=ebnadr%(j2%)+(j1%*i_breite%/8)
  96.         BGET #k%,scrz,i_breite%/8
  97.       NEXT j2%
  98.     NEXT j1%
  99.   ELSE IF comp%=1               ! Bild ist gepackt
  100.     FOR j1%=0 TO i_hoehe%-1     ! Anzahl der Bildzeilen
  101.       FOR j2%=0 TO ebenen%-1    ! Anzahl der Bitplanes
  102.         scrz=ebnadr%(j2%)+INT(j1%*breite%/8)
  103.         CLR bytez
  104.         WHILE bytez<INT(i_breite%/8)
  105.           BGET #k%,mem%,1       ! ein Byte lesen
  106.           byte=PEEK(mem%)
  107.           IF byte<128 THEN
  108.             BGET #k%,scrz+bytez,byte+1
  109.             bytez=bytez+byte+1
  110.           ELSE IF byte>128
  111.             BGET #k%,mem%,1
  112.             dtbyte=PEEK(mem%)
  113.             FOR i=bytez TO bytez+257-byte
  114.               POKE scrz+i,dtbyte
  115.             NEXT i
  116.             bytez=bytez+257-byte
  117.           ENDIF
  118.         WEND
  119.       NEXT j2%
  120.     NEXT j1%
  121.   ENDIF
  122.   dummy%=MFREE(mem%,2)          ! reservierten Speicher wieder freigeben
  123. RETURN
  124. PROCEDURE lese.bmhd(k%)         ! Bitmap-Header lesen
  125.   form$=""
  126.   SEEK #k%,filepointer%         ! Zeiger auf Anfang der Datei setzen
  127.   fp=filepointer%               ! Zeiger merken
  128.   WHILE LEFT$(form$,4)<>"BMHD"
  129.     lese.chunkname              ! Chunknamen und Chunklänge lesen
  130.     IF LEFT$(form$,4)<>"BMHD" THEN
  131.       lg1%=@chlaenge(form$)     ! Chunklänge berechnen
  132.       SEEK #k%,LOC(#k%)+lg1%    ! Zeiger auf den nächsten Chunk setzen
  133.     ENDIF
  134.   WEND
  135.   lg1%=@chlaenge(form$)         ! Chunklänge berechnen
  136.   mem%=MALLOC(lg1%,0)           ! Speicher reservieren
  137.   BGET #k%,mem%,lg1%            ! Chunk aus der Datei lesen
  138.   i_breite%=DPEEK(mem%)         ! Gesamtbreite der Grafik
  139.   i_hoehe%=DPEEK(mem%+2)        ! Gesamthöhe der Grafik
  140.   i_xstart%=DPEEK(mem%+4)       ! Startposition der Grafik (Rechtswert)
  141.   i_ystart%=DPEEK(mem%+6)       ! Startposition der Grafik (Hochwert)
  142.   ebenen%=PEEK(mem%+8)          ! Anzahl der Bitplanes
  143.   mask%=PEEK(mem%+9)            ! Masking
  144.   comp%=PEEK(mem%+10)           ! Kompressionart
  145.   dummy%=PEEK(mem%+11)          ! Füllbyte, frei für Erweiterungen
  146.   tcolor%=DPEEK(mem%+12)        ! transparente Farbe beim Masking
  147.   i_xaspect=PEEK(mem%+14)
  148.   i_yaspect=PEEK(mem%+15)
  149.   breite%=DPEEK(mem%+16)        ! Bildschirmbreite
  150.   hoehe%=DPEEK(mem%+18)         ! Bildschirmhöhe
  151.   dummy%=MFREE(mem%,lg1%)       ! reservierten Speicher wieder freigeben
  152. RETURN
  153. PROCEDURE lese.cmap(k%)         ! Color Chunk lesen
  154.   form$=""
  155.   SEEK #k%,filepointer%         ! Zeiger auf den Anfang der Datei setzen
  156.   WHILE LEFT$(form$,4)<>"CMAP"
  157.     lese.chunkname              ! Chunknamen und Chunklänge lesen
  158.     IF LEFT$(form$,4)<>"CMAP" THEN
  159.       lg1%=@chlaenge(form$)     ! Chunklänge berechnen
  160.       SEEK #k%,LOC(#k%)+lg1%    ! Zeiger auf den Chunk in der Datei setzen
  161.     ENDIF
  162.   WEND
  163.   lg1%=@chlaenge(form$)         ! Chunklänge berechnen
  164.   mem%=MALLOC(lg1%,0)           ! Speicher reservieren
  165.   BGET #k%,mem%,lg1%
  166.   farb%=lg1%/3                  ! Anzahl der Farben
  167.   FOR i=0 TO farb%-1            ! Farben zur weiteren Auswertung speichern
  168.     farben%(i,0)=PEEK(mem%+3*i)/16    ! rot
  169.     farben%(i,1)=PEEK(mem%+3*i+1)/16  ! grün
  170.     farben%(i,2)=PEEK(mem%+3*i+2)/16  ! blau
  171.   NEXT i
  172.   dummy%=MFREE(mem%,lg1%)       ! reservierten Speicher wieder freigeben
  173. RETURN
  174. PROCEDURE lese.camg(k%)         ! View-Mode bestimmen
  175.   form$=""
  176.   CLR lg1%
  177.   CLR ba%
  178.   SEEK #k%,filepointer%
  179.   WHILE LEFT$(form$,4)<>"CAMG" AND lg1%+LOC(#k%)<lo%
  180.     lese.chunkname              ! Chunknamen und Chunklänge lesen
  181.     IF LEFT$(form$,4)<>"CAMG" THEN
  182.       lg1%=@chlaenge(form$)
  183.       IF lg1%+LOC(#k%)<lo% THEN      ! Zeiger noch < Dateigröße?
  184.         SEEK #k%,LOC(#k%)+lg1%
  185.       ENDIF
  186.     ENDIF
  187.   WEND
  188.   IF LEFT$(form$,4)<>"BODY" THEN
  189.     i_camg=-1
  190.     lg1%=@chlaenge(form$)       ! Chunklänge berechnen
  191.     mem%=MALLOC(lg1%,0)         ! Speicher reservieren
  192.     BGET #k%,mem%,lg1%          ! Modus aus der Datei lesen
  193.     ba%=LPEEK(mem%)             ! Modus
  194.     IF BTST(ba%,7) THEN         ! Bit 7 gesetzt?
  195.       ba$="EHB"                 ! ja, dann ist es Extra Half B.-Modus
  196.     ELSE IF BTST(ba%,11)        ! Bit 11 gesetzt?
  197.       ba$="HAM"                 ! ja, dann ist es der HAM-Modus
  198.     ENDIF
  199.     dummy%=MFREE(mem%,lg1%)     ! reservierten Speicher wieder freigeben
  200.   ELSE IF LEFT$(form$,4)<>"BODY" AND lg1%+LOC(#k%)<lo%
  201.     lg1%=@chlaenge(form$)       ! Chunklänge berechnen
  202.     mem%=MALLOC(lg1%,0)         ! Speicher reservieren
  203.     BGET #k%,mem%,lg1%          ! Chunk aus der Datei lesen
  204.     i_camg=LPEEK(mem%)
  205.     dummy%=MFREE(mem%,lg1%)     ! reservierten Speicher wieder freigeben
  206.   ENDIF
  207. RETURN
  208. PROCEDURE menueein              ! Menüs einschalten
  209.   m$(0)="Bild"
  210.   m$(1)=" Laden "
  211.   m$(2)=" Ende  "
  212.   m$(3)=""
  213.   m$(4)=""
  214. RETURN
  215. PROCEDURE menuekontrolle
  216.   SELECT MENU(0)
  217.   CASE 1                !Laden
  218.     start
  219.     menueein
  220.     MENU m$()
  221.   CASE 2                !Speichern
  222.     programmende
  223.   ENDSELECT
  224. RETURN
  225. PROCEDURE programmende          ! Programm beenden
  226.   ALERT 0,"Wollen Sie aufhoeren?",2,"Ende|Weiter",wahl%
  227.   ende!=(wahl%=1)
  228. RETURN
  229. PROCEDURE start                 ! Haupt-Routine
  230.   fileauswahl("Laden eines Bildes:","Laden",pfad$,dateiname$)
  231.   IF abbruch%=0 THEN            ! Abbruchflag nicht gesetzt?
  232.     OPEN "i",#1,dateiname$      ! ja, dann Datei öffnen
  233.     lo%=LOF(#1)                 ! Dateigröße
  234.     test=@testilbm(1)           ! auf IFF-Datei testen
  235.     IF test=-1 THEN
  236.       PRINT "Keine IFF-Datei"
  237.       taste
  238.     ELSE IF test=-2
  239.       PRINT "Dieses ist eine IFF-Datei, jedoch keine Grafikdatei."
  240.       taste
  241.     ELSE
  242.       lese.bmhd(1)              ! Bitmapheader lesen
  243.       lese.cmap(1)              ! Colormap lesen
  244.       lese.camg(1)              ! View-Mode lesen
  245.       PRINT AT(1,26);" Bildname: ";bildname$
  246.       PRINT "    Größe: ";i_breite%;" x";i_hoehe%
  247.       PRINT "Bitplanes: ";ebenen%
  248.       PRINT "   Farben: ";
  249.       IF ebenen%<6 THEN
  250.         PRINT farb%
  251.       ELSE
  252.         PRINT farb%;"   ";
  253.         PRINT ba$;"-Modus."
  254.       ENDIF
  255.       PRINT "  Weiter mit Mausklick."
  256.       taste
  257.       lese.grafik(1)
  258.     ENDIF
  259.   ENDIF
  260.   CLOSE #1                      ! Bilddatei schließen
  261. RETURN
  262. PROCEDURE taste                 ! ein Zeichen von der Tastatur holen
  263.   CLR x%                        ! Steuerzeichen löschen
  264.   CLR mausk%
  265.   CLR mausx%                    ! Mausspalte löschen
  266.   CLR mausy%                    ! Mauszeile löschen
  267.   WHILE x%=0 AND MOUSEK=0
  268.     x$=INKEY$                   ! Zeichen von Tastatur
  269.     x%=ASC(x$)                  ! ASCII-Wert für Auswertung
  270.   WEND
  271.   IF MOUSEK<>0 THEN             ! linke Maustaste
  272.     mausx%=INT(MOUSEX/8)+1      ! ja, dann Spalte = mausx
  273.     mausy%=INT(MOUSEY/8)+1      ! Zeile = mausy
  274.     mausk%=MOUSEK               ! Maustaste
  275.   ENDIF
  276. RETURN
  277. FUNCTION chlaenge(x$)           ! Chunklänge berechnen
  278.   LOCAL i%,a,b%
  279.   CLR a
  280.   CLR b%
  281.   FOR i%=4 TO 1 STEP -1
  282.     a=ASC(MID$(x$,9-i%,1))
  283.     b%=b%+a*2^(8*(i%-1))
  284.   NEXT i%
  285.   RETURN b%                     ! Chunklänge zurückgeben
  286. ENDFUNC
  287. FUNCTION testilbm(k%)           ! auf IFF-Datei testen
  288.   form$=""
  289.   IF LOF(#k%)<12 THEN           ! 12 Bytes lesen
  290.     RETURN -1                   ! Flag keine IFF-Datei
  291.   ENDIF
  292.   FOR i=0 TO 11
  293.     form$=form$+CHR$(INP(k%))
  294.   NEXT i
  295.   IF LEFT$(form$,4)<>"FORM" THEN ! die ersten vier Zeichen = "FORM"?
  296.     RETURN -1                   ! nein, dann keine IFF-Datei
  297.   ELSE IF RIGHT$(form$,4)<>"ILBM"
  298.     RETURN -2                   ! Flag für keine Grafik-Datei
  299.   ENDIF
  300.   filepointer%=LOC(#k%)
  301.   RETURN 0                      ! OK-Flag
  302. ENDFUNC
  303.